home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / demostuf / ilbm256.pas < prev    next >
Pascal/Delphi Source File  |  1994-07-25  |  4KB  |  224 lines
  1. UNIT ILBM256;
  2. {
  3.     Converts IFF/ILBM image file in format 320*200 in 256 colours
  4.     a raw image...
  5.  
  6.   THIS PROGRAM WAS CODED BY BJARKE VIKS0E.
  7.   YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
  8.   E-MAIL ME AT: dat92230@rix02.lyngbyes.dk IN 1994 FOR CHAT AND CODE.
  9. }
  10.  
  11. INTERFACE
  12.  
  13. uses
  14.     DEMOINIT;
  15.  
  16. type
  17.     pBuffer = ^buffertype;
  18.     buffertype = array[1..64000] of byte;
  19.  
  20. var
  21.     cmap : array[1..256*3] of byte;
  22.  
  23.  
  24. procedure LoadPix(buffer : pScreen; filename : string);
  25. procedure ConvertIFF(p : pScreen; v : pBuffer);
  26. procedure SetCMAP;
  27. procedure Copy2Screen(v : pScreen; s : pScreen);
  28. procedure Copy2TweakScreen(v : pScreen; s : pScreen);
  29. procedure MakeTweak(scr1,scr2 : pScreen);
  30. procedure FadeCMAP(faktor : integer);
  31.  
  32.  
  33. (*--------------------------------------*)
  34.  
  35. IMPLEMENTATION
  36.  
  37.  
  38. procedure IFFcmap(v : pBuffer; i, clength : longint);
  39. var
  40.     r,g,b : byte;
  41.     j,k : integer;
  42. begin
  43.     k:=1;
  44.     for j:=1 to (clength DIV 3) do begin
  45.         r:=v^[i] div 4; g:=v^[i+1] div 4; b:=v^[i+2] div 4;
  46.         inc(i,3);
  47.         cmap[k]:=r; cmap[k+1]:=g; cmap[k+2]:=b;
  48.         inc(k,3);
  49.     end;
  50. end;
  51.  
  52.  
  53. procedure IFFbody(p : pScreen; v : pBuffer; i : longint; VAR done : boolean);
  54. var
  55.     n : word;
  56.     c : shortint;
  57.     fill : byte;
  58. begin
  59.     n:=0; { actual screen offset }
  60.     repeat
  61.         c:=v^[i]; inc(i);
  62.         if (c < 0) then begin
  63.             c:=-c;
  64.             fill:=v^[i]; inc(i);
  65.             FillChar(p^[n],c+1,fill);
  66.             inc(n,c+1);
  67.         end
  68.         else begin
  69.             Move(v^[i],p^[n],c+1);
  70.             inc(i,c+1);
  71.             inc(n,c+1);
  72.         end;
  73.     until (n >= 320*200);
  74.  
  75.     done:=TRUE;
  76. end;
  77.  
  78.  
  79. procedure ConvertIFF(p : pScreen; v : pBuffer);
  80. var
  81.     i : longint;
  82.     done : boolean;
  83.     flength : longint;
  84.     clength : longint;
  85.     chunkname : string[4];
  86. begin
  87.     if (char(v^[1])<>'F') AND (char(v^[2])<>'O') AND (char(v^[3])<>'R') AND (char(v^[4])<>'M') then exit;
  88.     flength:=v^[5] shl 8;
  89.     inc(flength,v^[6]); flength:=flength shl 8;
  90.     inc(flength,v^[7]); flength:=flength shl 8;
  91.     inc(flength,v^[8]);
  92.     if (char(v^[9])<>'P') AND (char(v^[10])<>'B') AND (char(v^[11])<>'M') AND (char(v^[12])<>' ') then exit;
  93.  
  94.     i:=13;
  95.     done:=FALSE;
  96.     repeat
  97.         chunkname:=concat(char(v^[i]),char(v^[i+1]),char(v^[i+2]),char(v^[i+3]));
  98.         inc(i,4);
  99.  
  100.         clength:=v^[i] shl 8;
  101.         inc(clength,v^[i+1]); clength:=clength shl 8;
  102.         inc(clength,v^[i+2]); clength:=clength shl 8;
  103.         inc(clength,v^[i+3]);
  104.         if odd(clength) then inc(clength);
  105.         inc(i,4);
  106.  
  107.         if (chunkname='CMAP') then IFFcmap(v, i,clength);
  108.         if (chunkname='BODY') then IFFbody(p,v, i,done);
  109.         inc(i,clength);
  110.     until (i > flength) OR done;
  111. end;
  112.  
  113.  
  114. procedure LoadPix(buffer : pScreen; filename : string);
  115. var
  116.     pFileMem: pBuffer;
  117.     FileHandle : file;
  118.     size : longint;
  119. begin
  120.     Assign(FileHandle, filename);
  121.     Reset(FileHandle, 1);
  122.     size := filesize(FileHandle);
  123.     GetMem(pFileMem, size);
  124.     BlockRead(FileHandle, pFileMem^, size);
  125.     Close(FileHandle);
  126.     ConvertIFF(buffer, pFileMem);
  127.     FreeMem(pFileMem, size);
  128. end;
  129.  
  130.  
  131. (*--------------------------------------*)
  132.  
  133. procedure SetCMAP;
  134. var
  135.     i,j : integer;
  136. begin
  137.     j:=1;
  138.     for i:=0 to 255 do begin
  139.         SetRGB(i,cmap[j],cmap[j+1],cmap[j+2]);
  140.         inc(j,3);
  141.     end;
  142. end;
  143.  
  144.  
  145. procedure Copy2Screen(v : pScreen; s : pScreen); assembler;
  146. asm
  147.     push    ds
  148.     lds    si,v
  149.     les    di,s
  150.     cld
  151.     mov    cx,320*200/2
  152.     rep movsw
  153.     pop    ds
  154. end;
  155.  
  156.  
  157. procedure Copy2TweakScreen(v : pScreen; s : pScreen);
  158.     procedure CopyPlane(v : pScreen; s : pScreen); assembler;
  159.     asm
  160.         push    ds
  161.         lds    si,v
  162.         les    di,s
  163.         cld
  164.         mov    cx,80*200/2
  165.         rep movsw
  166.         pop    ds
  167.     end;
  168. const
  169.     size = 80*200;
  170. begin
  171.     SetBitplanes(1);
  172.     CopyPlane(@v^[0],s);
  173.     SetBitplanes(2);
  174.     CopyPlane(@v^[size+0],s);
  175.     SetBitplanes(4);
  176.     CopyPlane(@v^[size*2+0],s);
  177.     SetBitplanes(8);
  178.     CopyPlane(@v^[size*3+0],s);
  179. end;
  180.  
  181.  
  182. procedure MakeTweak(scr1,scr2 : pScreen);
  183. var
  184.     i,scroffset : integer;
  185. begin
  186.     scroffset:=0;
  187.     for i:=0 to 3 do begin
  188.         SetBitplanes(1 shl i);
  189.         asm
  190.             push    ds
  191.             lds    si,scr1
  192.             les    di,scr2
  193.             add    si,i
  194.             add    di,scroffset
  195.             mov    cx,80*200
  196.             mov    dx,4
  197.             cld
  198. @loop1:    mov    al,[si]
  199.             stosb
  200.             add    si,dx
  201.             loop    @loop1
  202.             pop    ds
  203.         end;
  204.         inc(scroffset,80*200);
  205.     end;
  206. end;
  207.  
  208. procedure FadeCMAP(faktor : integer);
  209. var
  210.     i,j : integer;
  211. begin
  212.     VBLANK;
  213.     j:=1;
  214.     for i:=0 to 255 do begin
  215.         SetRGB(i,
  216.                 longmul(cmap[j],faktor) shr 8,
  217.                 longmul(cmap[j+1],faktor) shr 8,
  218.                 longmul(cmap[j+2],faktor) shr 8);
  219.         inc(j,3);
  220.     end;
  221. end;
  222.  
  223. end.
  224.